home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / COMM / PPL4P10A / ZDATE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-20  |  3KB  |  116 lines
  1. (********************************************)
  2. (*                                          *)
  3. (*  This program is donated to the Public   *)
  4. (*  Domain by MarshallSoft Computing, Inc.  *)
  5. (*                                          *)
  6. (********************************************)
  7.  
  8. UNIT zdate;
  9. INTERFACE
  10. USES Dos;
  11.  
  12. Function Dos2Zdate(TheDate: LongInt): String;
  13. Function Z2DosDate(Text: String): LongInt;
  14.  
  15. IMPLEMENTATION
  16.  
  17. Const
  18.    K1970 = 2440588;
  19.    K0 =    1461;
  20.    K1 =  146097;
  21.    K2 = 1721119;
  22.  
  23. Procedure Greg2Julian(Year,Month,Day : Integer; Var Julian : LongInt);
  24. Var
  25.   Century  : LongInt;
  26.   XYear    : LongInt;
  27. Begin {Greg2Julian}
  28.   If Month <= 2 then
  29.      begin
  30.         Year := pred(Year);
  31.         Month := Month + 12;
  32.      end;
  33.   Month := Month - 3;
  34.   Century := Year div 100;
  35.   XYear := Year mod 100;
  36.   Century := (Century * K1) shr 2;
  37.   XYear := (XYear * K0) shr 2;
  38.   Julian := ((((Month * 153) + 2) div 5) + Day) + K2 + XYear + Century;
  39. end; {Greg2Julian}
  40.  
  41. Procedure Julian2Greg(Julian : LongInt; Var Year,Month,Day : Integer);
  42. Var
  43.   Temp    : LongInt;
  44.   XYear   : LongInt;
  45.   YYear   : Integer;
  46.   YMonth  : Integer;
  47.   YDay    : Integer;
  48. begin {Julian2Greg}
  49.   Temp := (((Julian - K2) shl 2) - 1);
  50.   XYear := (Temp mod K1) or 3;
  51.   Julian := Temp div K1;
  52.   YYear := (XYear div K0);
  53.   Temp := ((((XYear mod K0) + 4) shr 2) * 5) - 3;
  54.   YMonth := Temp div 153;
  55.   If YMonth >= 10 then
  56.      begin
  57.         YYear := YYear + 1;
  58.         YMonth := YMonth - 12;
  59.      end;
  60.   YMonth := YMonth + 3;
  61.   YDay := Temp mod 153;
  62.   YDay := (YDay + 5) div 5;
  63.   Year := YYear + (Julian * 100);
  64.   Month := YMonth;
  65.   Day := YDay;
  66. end; {Julian2Greg}
  67.  
  68. Function Dos2Zdate(TheDate: LongInt): String;
  69. Var
  70.    DateAndTime : DateTime;
  71.    SecsPast : LongInt;
  72.    DateNbr  : LongInt;
  73.    DaysPast : LongInt;
  74.    Text     : String;
  75. Begin
  76.    UnpackTime(TheDate,DateAndTime);
  77.    Greg2Julian(DateAndTime.year,DateAndTime.month,DateAndTime.day,DateNbr);
  78.    DaysPast := DateNbr - K1970;
  79.    SecsPast := DaysPast * 86400;
  80.    SecsPast := SecsPast + DateAndTime.hour * 3600 + DateAndTime.min * 60
  81.               + DateAndTime.sec;
  82.    Text := '';
  83.    While (SecsPast <> 0) and (Length(Text) < 255) do
  84.       Begin
  85.          {extract next octal digit}
  86.          Text := Chr((SecsPast AND 7) + $30) + Text;
  87.          SecsPast := (SecsPast SHR 3)
  88.       End;
  89.    Text := '0' + Text;
  90.    Dos2Zdate := Text
  91. End;
  92.  
  93. Function Z2DosDate(Text: String): LongInt;
  94. Var
  95.    n  : Word;
  96.    DateAndTime : DateTime;
  97.    SecsPast    : LongInt;
  98.    DateNbr     : LongInt;
  99. Begin
  100.    SecsPast := LongInt(0);
  101.    For n := 1 to Length(Text) do
  102.       SecsPast := (SecsPast SHL 3) + Ord(Text[n]) - $30;
  103.    DateNbr := (SecsPast DIV 86400) + K1970;
  104.    Julian2Greg(DateNbr,Integer(DateAndTime.year),
  105.       Integer(DateAndTime.month),Integer(DateAndTime.day));
  106.    SecsPast := SecsPast MOD 86400;
  107.    DateAndTime.hour  := SecsPast DIV 3600;
  108.    SecsPast := SecsPast MOD 3600;
  109.    DateAndTime.min := SecsPast DIV 60;
  110.    DateAndTime.sec := SecsPast MOD 60;
  111.    PackTime(DateAndTime,SecsPast);
  112.    Z2DosDate := SecsPast
  113. End;
  114.  
  115. End.
  116.